perm filename TABL.F4[RST,LCS] blob sn#217901 filedate 1976-05-30 generic text, type T, neo UTF8
00100	C** TABL.F4 ** CONVERTS STANDARD NOTATION TO 1700 LUTE TABLATURE.
00200	
00300		SUBROUTINE EXTRA 
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSC(8),RSTJ2
00600		1 /POSI/SF(8),JJ2,RPOS  /PTR/KWDS(250),ITEM,L,I,IX /XRN/RN(2000)
00700		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(R3,RJQ(1))
00800		1 ,(J6,JQ(4)),(R11,RJQ(9)),(J10,JQ(8)),(R5,RJQ(3)),(J3,JQ(1))
00900		1,(J11,JQ(9)),(RX3,RJQ(20)),(R9,RJQ(7)),(R8,RJQ(6)),(JR3,RJQ(19))
01000		1,(J7,JQ(5)),(R10,RJQ(8))
01100	
01200		DIMENSION RS(5),KEY(10),ISTR(6)
01300		DATA RS/2.,4.,6.,9.,11./,KEY/3,0,4,1,-1,5,2,6,3,0/
01400		1,ISTR/0,5,8,12,17,20/,KSIG/9/
01500	C RS CONVERTS STRING NUM TO LINE NUM.  KEY INCL'S. 4b TO 5#
01600	C ISTR HAS 12-TONE NOTE NUM OF STRINGS 1 TO 6(A=0)
01700	
01800		GO TO (1,2),JA
01900	1	IF(KSIG.LE.8)GO TO 51
02000	C NEXT SEARCHES FOR KSIG, AT LEAST ONCE.  SET P11=8 TO CANCEL KSIG FEATURE
02100		IF(J11.NE.0)GO TO 51
02200		DO 52 K=1,ITEM
02300		L=KWDS(K)
02400		IF(RN(L+1).NE.17)GO TO 52
02500		IF(RN(L+2).NE.R2)GO TO 52
02600		KSIG=RN(L+5)
02700		GO TO 51
02800	52	CONTINUE
02900		KSIG=8
03000	C SO IT WON'T SEARCH EVERY TIME. NOW KSIG MUST BE SET BY P11.
03100		GO TO 51
03200	15	J10=0
03300	51	IF(J10.NE.0)GO TO 50
03400	C STRNG NUM CAN BE SET IN J10 OR IN R6 -- 1=.001, 2=.002, ETC. J10 IS FIRST.
03500	C R6 IS USED IN 'TAB.F4' WHICH CONVERTS TABLATURE TO MS INPUT.
03600		R6=AMOD(R6*100.0,10.0)
03700	C  R6 WAS MULTIPLIED BY 10 IN NOTWRT.  .001 HAS BECOME .01, ETC.
03800		J10=R6
03900		IF(J10.NE.0)J6=0
04000	C MAKE J6=0 IF AUTOMATIC STRING NUMS ARE IN DECIS OF R6.
04100		R6=0
04200	50	IF(J10.EQ.0)GO TO 18
04300	C TO SPECIFY LETTER (P6), P10 MUST! ALSO BE NON-ZERO. (USE P10>6 FOR STR.0)
04400	CC*******	IF(J10.GT.6)J10=7
04500		J10=7-J10
04600		IF(J6.LE.0)GO TO 18
04700	C J10 SETS STRING# (1→12), J6 SETS LET. OR NUM.(e.g.'-4' PRINTS '4',1=A)
04800	C  STRINGS ARE NUMBERED FROM HIGH TO LOW
04900		L=J10*2-1
05000	C  GETS STAFF POS FROM STRING NUM.
05100		N=J6-1
05200		IF(J10.GE.0.AND.N.GE.0)GO TO 9
05300	CC*******	N=N+1
05400	CC******	N=-N-1
05450		J=J10
05500	C TO PRINT LETTERS OTHER THAN 'A' ON BASS STRINGS
05510		IF(J6)J=J6
05520	C  NEG VALUES .LE. -4 WILL PRINT BASS STRING NUMBERS ONLY.
05600	16	L=-1
05700	C STRINGS 0 TO -6 ALL APPEAR BELOW 6-LINE STAFF.
05800		IF(J.GE.0)GO TO 9
05900	C JUMP IF FINGERED NOTE ON STRING 0
06000	CC******	IF(N.EQ.0)GO TO 13
06100		L=-2
06200		IF(J.LT.-3)GO TO 30
06300	C  NEXT FOR SLASHES OVER a.
06400		R4=1.0
06500		R5=2.4
06600		IF(J.EQ.-1)GO TO 33
06700		L=-3
06800		R4=0  
06900		R5=1.4
07000	33	JR3=R3
07100	C  SAVE FOR LATER
07200		R3=R3-7.*RSTJ2
07300		R6=RX3+4*RSTJ2
07400	C  RX3 IS ORIG. HORIZ. POS. (SCALE 0-200)
07500		JA=4
07600		J7=1
07700		RP=RPOS
07800	C SAVE VERT. POS. BASIS
07900		DO 32 K=1,-J
08000		J10=1
08100		R8=4.2
08200		R9=0
08300		CALL ITMSUB
08400		J3=JR3
08500		RPOS=RP
08600		R4=R4+.7
08700	32	R5=R5+.7
08800	CC	IF(N.NE.0)N=N-1
08900	C  GET THE RIGHT LETTER
08910		IF(R10.EQ.0)N=0
09000		GO TO 9
09300	30	R4=51009999.0
09400		GO TO 13
09500	
09600	18	J=MOD(J5,10)
09700		M=R4
09800		IF(M.GT.-2)GO TO 21
09900		J=M+2
09950		N=-J
10000		GO TO 16
10100	21	N=MOD(M-1,7)+2
10200		IF(N.GT.6)N=N-7
10300	C  N IS NOTE NUMBER, WHERE A3=0
10400		IF(N)GO TO 16
10500	C  FOR ALL NOTES BELOW A3 GO BACK TO J6 ROUTINE.
10600		IF(J.EQ.0)GO TO 6
10700	C  JUMP IF NO  ACCI.
10800	
10900		IF(J.EQ.1)J=-1
11000		IF(J.EQ.2)J=1
11100		IF(J.EQ.3)J=0
11200	C  J= 1/2 STEP FROM CENTRAL PITCH
11300		GO TO 7
11400	6	IF(J11.NE.0)KSIG=J11
11500		IF(KSIG.GT.7)GO TO 7
11600	C  J11>7 CANCELS KSIG
11700	C  GIVE KEYSIG. IN P11  +=#, -=b
11800		M=KSIG+5
11900		J=1
12000		IF(KSIG)J=-1
12100		DO 4 K=5,M,J
12200	4	IF(N.EQ.KEY(K))GO TO 7
12300	C LOOK FOR THE NOTE IN THE KEYSIG.
12400		J=0
12500	C  0= NOT FOUND IN KEYSIG.
12600	7	R11=0
12700		IF(J10.GT.0)GO TO 5
12800	C JUMP IF STRING IS SPECIFIED
12900		DO 10 L=1,5
13000	10	IF(R4.LT.RS(L))GO TO 20
13100		L=6
13200	C L IS STRING NUMBER.
13300	20	L=L*2-1
13400		IF(J.GE.0)GO TO 5
13500	C  NEXT CHECKS FOR FLATS THAT CHANGE STRING NUM.
13600		IF(N.EQ.0)GO TO 8
13700		IF(N.EQ.3)GO TO 8
13800		IF(N.NE.5)GO TO 5
13900	CC8	L=L-1
14000	C CHANGES Ab→G#, Db→C#
14100	CC	N=N-1
14200	CC	J=1
14300	8	R4=R4-1.
14400		J5=2
14500		GO TO 18
14600	C  DOESN'T ACCOUNT FOR F FLAT, ETC.
14700	
14800	5	NN=N*2
14900	C NEXT CONVERTS TO 12-TONE NUMS.
15000		IF(N.GT.1)NN=NN-1
15100		IF(N.GT.4)NN=NN-1
15200	C  COMPENSATES FOR B-C AND E-F 1/2 STEPS IN SCALE
15300		N=NN
15400		IF(J10.GT.0)GO TO 14
15500		IF(R4.GE.13)GO TO 17
15600		IF(NN.GT.4)N=NN-5
15700		IF(NN.GT.7)N=NN-8
15800	C N IS NOW A LETTER ON A OR D OR F STRING (0=A, 1=B, ETC.)
15900	
16000	11	N=N+J
16100		GO TO 9
16200	17	J10=6
16300	14	IF(J10.GT.6)GO TO 15
16400		R5=R4
16500		IF(J)R5=R5-1.
16600		IF(R5.GE.6.)N=N+12
16700		IF(R5.GE.13.)N=N+12
16800		N=N-ISTR(J10)+J
16900		IF(N)GO TO 15
17000		L=J10*2-1
17100	
17200	9	IF(N.GT.8)N=N+1
17250		R4=51709999.0
17300	C SKIPS THE LETTER 'J'
17400	31	IF(N.EQ.2)N=17
17500	C  CHANGES C TO R
17600	13	R6=R4+N*10000   
17700		R5=.95
17800		R4=L+1.28125
17900		IF(N.EQ.3)R11=268
18000	C ROTATES 'D'
18100		J3=J3+6.*RSTJ2
18200		CALL ALPHA
18300	2	END